home *** CD-ROM | disk | FTP | other *** search
/ MacWorld 1998 January / Macworld (1998-01).dmg / Shareware World / Comms & Internet / HTML mode 2.0 etc. / htmlCustom.tcl < prev    next >
Text File  |  1997-09-22  |  45KB  |  1,245 lines
  1. ## -*-Tcl-*-
  2.  # ###################################################################
  3.  #  HTML mode - tools for editing HTML documents
  4.  # 
  5.  #  FILE: "htmlCustom.tcl"
  6.  #                                    created: 96-06-29 21.36.50 
  7.  #                                last update: 97-08-23 22.09.19 
  8.  #  Author: Johan Linde
  9.  #  E-mail: <jl@theophys.kth.se>
  10.  #     www: <http://bach.theophys.kth.se/~jl/Alpha.html>
  11.  #  
  12.  # Version: 2.0
  13.  # 
  14.  # Copyright 1996, 1997 by Johan Linde
  15.  #  
  16.  # This software may be used freely, and distributed freely, as long as the 
  17.  # receiver is not obligated in any way by receiving it.
  18.  #  
  19.  # If you make improvements to this file, please share them!
  20.  # 
  21.  # ###################################################################
  22.  ##
  23.  
  24. #
  25. # Defining new HTML elements.
  26. #
  27. proc htmlNewElement {} {
  28.     global htmlElemAttrOptional1 htmlURLAttr htmlColorAttr htmlWindowAttr htmlElemAttrUsed
  29.     global PREFS htmlElemAttrRequired1 htmlElemAttrChoices1 htmlElemAttrNumber1
  30.     global htmlElemEventHandler1 htmlElemProc htmlElemKeyBinding htmlPlugins htmlElemAttrMore
  31.     global HTMLmodeVars specURL specColor specWindow htmlSpecURL htmlSpecColor htmlSpecWindow
  32.     global htmlVersion htmlShownWarning htmlAdditionExist htmlPackageToUse cssModeIsLoaded
  33.     
  34.     if {$htmlPackageToUse != 1} {beep; return}
  35.     if {[info exists htmlShownWarning]} {htmlDisabled}
  36.     set invalidInput 1
  37.     set values {"" 1 1 0 0}
  38.     while {$invalidInput} {
  39.         set box "-t {New element} 10 10 100 25 -e [list [lindex $values 0]] 110 10 250 25 \
  40.         -c {Has closing tag} [lindex $values 1] 10 40 150 55 \
  41.         -t {Element type} 10 80 100 95 -r Normal [lindex $values 2] 10 100 100 115 \
  42.         -r {INPUT element with TYPE given above} [lindex $values 3] 10 120 300 135 \
  43.         -r {Plug-in} [lindex $values 4] 10 140 100 155 \
  44.         -b OK 20 170 85 190 -b Cancel 105 170 170 190"
  45.         set values [eval [concat dialog -w 340 -h 200 $box]]
  46.         if {[lindex $values 6]} {return}
  47.         set element [string toupper [string trim [lindex $values 0]]]
  48.         set closingTag [lindex $values 1]
  49.         if {[lindex $values 2]} {
  50.             set elemType normal
  51.         } elseif {[lindex $values 3]} {
  52.             set elemType input
  53.         } else {
  54.             set elemType plugin
  55.         }
  56.         # Check that input is ok.
  57.         if {![string length $element]} {
  58.             alertnote "You must specify the element."
  59.         } elseif {[info exists htmlElemAttrOptional1($element)]} {
  60.             alertnote "The element $element is already defined."
  61.             return
  62.         } elseif {![regexp {^[-_a-zA-Z0-9]+$} $element]} {
  63.             alertnote "Invalid characters in element name. For example, it may not contain spaces."
  64.         } else {
  65.             set invalidInput 0
  66.         }
  67.     }
  68.  
  69.     # Get a key binding.
  70.     if {[catch {htmlGetAKey $element ""} keyStr]} {return}
  71.     
  72.     # Get the attributes    
  73.     set allattributes [htmlGetCustomAttrs $element {}]
  74.     if {![string length $allattributes]} {return}
  75.     set optional [lindex $allattributes 0]
  76.     set AttrRequired [lindex $allattributes 1]
  77.     set AttrNumber [lindex $allattributes 2]
  78.     set AttrChoices [lindex $allattributes 3]
  79.     set EventHandler [lindex $allattributes 4]
  80.     set URL [lindex $allattributes 5]
  81.     set Color [lindex $allattributes 6]
  82.     set Window [lindex $allattributes 7]
  83.     # Get the layout.
  84.     if {$elemType != "normal" || !$closingTag} {
  85.         set customproc [htmlSetCustProc1 {0 0} $elemType $element]
  86.     } else {
  87.         set customproc [htmlSetCustProc2 {1 0 0 0} $element]
  88.     }
  89.     if {![string length $customproc]} {return}
  90.     
  91.     # Save the element
  92.     message "Saving new element…"
  93.     set isfile [file exists $PREFS:HTMLadditions.tcl]
  94.     if {![file exists $PREFS]} {mkdir $PREFS}
  95.     set fid [open $PREFS:HTMLadditions.tcl a+]
  96.     if {!$isfile} {puts $fid $htmlVersion}
  97.     puts $fid "$element \{set htmlElemKeyBinding($element) [list $keyStr]\}"
  98.     set htmlElemKeyBinding($element) $keyStr
  99.     htmlDeleteCache "CSS keybindings cache"
  100.     if {[info exists cssModeIsLoaded]} {cssBindOneKey $keyStr $element}
  101.     puts $fid "$element \{set htmlElemProc($element) [list $customproc]\}"
  102.     set htmlElemProc($element) $customproc
  103.     foreach rcne [list AttrRequired AttrChoices AttrNumber EventHandler] {
  104.         if {[llength [set $rcne]]} {
  105.             puts $fid "$element \{set htmlElem${rcne}1($element) [list [set $rcne]]\}"
  106.             set htmlElem${rcne}1($element) [set $rcne]
  107.         }
  108.     }
  109.     # Remove possible old versions of htmlElemAttrUsed and htmlElemAttrMore
  110.     if {[info exists htmlElemAttrUsed($element)]} {
  111.         unset htmlElemAttrUsed($element)
  112.         removeArrDef htmlElemAttrUsed $element
  113.     }
  114.     if {[info exists htmlElemAttrMore($element)]} {
  115.         unset htmlElemAttrMore($element)
  116.         removeArrDef htmlElemAttrMore $element
  117.     }
  118.     
  119.     puts $fid "$element \{set htmlElemAttrOptional1($element) [list $optional]\}"
  120.     set htmlElemAttrOptional1($element) $optional
  121.     foreach ucw [list URL Color Window] {
  122.         if {[llength [set $ucw]]} {
  123.             foreach a [set $ucw] {
  124.                 puts $fid "$element \{lappend html${ucw}Attr $a\}"
  125.                 lappend html${ucw}Attr $a
  126.             }
  127.         }
  128.     }
  129.     if {$elemType == "plugin"} {
  130.         puts $fid "$element \{lappend htmlPlugins $element\}"
  131.         lappend htmlPlugins $element
  132.     }
  133.     foreach ucw [list URL Color Window] {
  134.         if {[llength [set spec$ucw]]} {
  135.             puts $fid "$element \{lappend htmlSpec$ucw [set spec$ucw]\}"
  136.             append htmlSpec$ucw " " [set spec$ucw]
  137.         }
  138.     }
  139.     close $fid
  140.     
  141.     set htmlAdditionExist 1
  142.     htmlRebuildMenu "Inserting new element in menu…"
  143.     htmlEnableExtend [info exists htmlElemKeyBinding] $htmlAdditionExist    
  144.     if {!$HTMLmodeVars(simpleColoring)} {
  145.         regModeKeywords -a -k $HTMLmodeVars(tagColor) HTML [concat "<$element" "/$element"]
  146.         regModeKeywords -a -k $HTMLmodeVars(attributeColor) HTML [concat $AttrRequired $optional]
  147.     }
  148.     message "Done."
  149.     if {[htmlUseAttrsIsEnabled] && [llength $optional]} {htmlUseAttributes $element}
  150.     unset specURL
  151.     unset specColor
  152.     unset specWindow
  153. }
  154.  
  155. # Get attributes to custom element.
  156. proc htmlGetCustomAttrs {element allattrs {nomore 1}} {
  157.     global htmlURLAttr htmlColorAttr htmlWindowAttr
  158.     global specURL specColor specWindow
  159.     
  160.     set allHTMLattrs [htmlGetAllAttrs]
  161.     set optional {}
  162.     set AttrRequired {}
  163.     set AttrChoices {}
  164.     set AttrNumber {}
  165.     set EventHandler {}
  166.     set URL {}
  167.     set Color {}
  168.     set Window {}
  169.     set specURL {}
  170.     set specColor {}
  171.     set specWindow {}
  172.     set i 0
  173.     set dispAttr $allattrs
  174.     
  175.     while {1} {
  176.         incr i
  177.         if {[catch {htmlCustomInpAttr $element $i $dispAttr $nomore} attribute]} {
  178.             if {$attribute != "Remove last!"} {return}
  179.             set toremove [lindex $dispAttr [expr [llength $dispAttr] - 1]]
  180.             set dispAttr [lreplace $dispAttr [expr [llength $dispAttr] - 1] [expr [llength $dispAttr] - 1]]
  181.             set allattrs [lreplace $allattrs [expr [llength $allattrs] - 1] [expr [llength $allattrs] - 1]]
  182.             set elemrm [lindex $toremove 0]
  183.             if {[lindex $toremove 1] == "(Flag)"} {
  184.                 if {[set ind [lsearch -exact $AttrRequired $elemrm]] >=0} {
  185.                     set AttrRequired [lreplace $AttrRequired $ind $ind]
  186.                 } elseif {[set ind [lsearch -exact $optional $elemrm]] >=0} {
  187.                     set optional [lreplace $optional $ind $ind]
  188.                 }
  189.             } else {
  190.                 foreach l [list optional AttrRequired AttrChoices AttrNumber EventHandler URL Color Window] {
  191.                     set tmp {}
  192.                     foreach m [set $l] {
  193.                         if {![string match "${elemrm}=*" $m]} {
  194.                             lappend tmp $m
  195.                         }
  196.                     }
  197.                     set $l $tmp
  198.                 }
  199.             }
  200.             foreach l [list URL Color Window] {
  201.                 if {[set where [lsearch -exact [set spec$l] "${element}=[string trimright $elemrm =]"]] >= 0 || \
  202.                 [set where [lsearch -exact [set spec$l] "${element}!=[string trimright $elemrm =]"]] >= 0} {
  203.                     set spec$l [lreplace [set spec$l] $where $where]
  204.                 }
  205.             }
  206.             incr i -2
  207.             continue
  208.         }
  209.         if {![string length $attribute]} {break}
  210.         if {[lsearch -exact [string toupper $allattrs] [string toupper [lindex $attribute 0]]] >= 0} {
  211.             alertnote "$element already has an attribute '[lindex $attribute 0]'."
  212.             incr i -1
  213.         } else {
  214.             if {[catch {htmlCustomAttrFix $element [lindex $attribute 0] \
  215.             [lindex $attribute 1] $allHTMLattrs} thisattr]} {
  216.                 incr i -1 
  217.                 continue
  218.             }
  219.             lappend allattrs [string trimright [lindex $thisattr 0] =]
  220.             set attr [lindex $thisattr 0]
  221.             set thistype [lindex $thisattr 1]
  222.             if {[lindex $attribute 2]} {
  223.                 lappend AttrRequired $attr
  224.             } elseif {$thistype != "Event handler"} {
  225.                 lappend optional $attr
  226.             } else {
  227.                 lappend EventHandler $attr
  228.             }
  229.             set attrext [expr ([lsearch -exact $allHTMLattrs $attr] >= 0 || [lsearch -exact $allHTMLattrs [string trimright $attr =]] >= 0)]
  230.             if {$thistype == "Choices"} {
  231.                 foreach c [lindex $thisattr 2] {
  232.                     lappend AttrChoices "$attr$c"
  233.                 }
  234.             } elseif {$thistype == "Number"} {
  235.                 lappend AttrNumber "$attr[lindex $thisattr 2]"
  236.             } elseif {$thistype == "URL" && [lsearch -exact $htmlURLAttr $attr] < 0 && !$attrext} {
  237.                 lappend URL $attr
  238.             } elseif {$thistype == "Color" && [lsearch -exact $htmlColorAttr $attr] < 0 && !$attrext} {
  239.                 lappend Color $attr
  240.             } elseif {$thistype == "Window" && [lsearch -exact $htmlWindowAttr $attr] < 0 && !$attrext} {
  241.                 lappend Window $attr
  242.             }
  243.             lappend dispAttr "[string trimright $attr =] (${thistype})"
  244.         }
  245.     }
  246.     return [list $optional $AttrRequired $AttrNumber $AttrChoices $EventHandler $URL $Color $Window]
  247. }
  248.  
  249. # Dialog for giving a new attribute.
  250. proc htmlCustomInpAttr {element num allattrs nomore} {
  251.     set typeList [list Other Number Choices Flag URL Color Window {Event handler}]
  252.     set values {0 0 {} Other 0}
  253.     set invalidInput 1
  254.     while {$invalidInput} {
  255.         set box "-t {Attribute $num for $element} 10 10 330 25 \
  256.         -e [list [lindex $values 2]] 10 40 150 55 \
  257.         -t Type: 170 40 205 55 \
  258.         -m [list [concat [list [lindex $values 3]] $typeList]] \
  259.         210 40 330 55 -c Required [lindex $values 4] 10 70 130 85"
  260.          if {$num > 1} {append box " -b {Remove last} 340 100 450 120"}
  261.          if {$nomore || $num > 1} {append box " -b {No more attributes} 340 70 480 90"}
  262.         set wi 10
  263.         set ht 120
  264.         if {[llength $allattrs]} {
  265.             append box " -t {All attributes} 10 100 200 115"
  266.             foreach ch $allattrs {
  267.                 append box " -t [list $ch] $wi $ht [expr $wi + 195] [expr $ht + 15]"
  268.                 incr wi 200
  269.                 if {$wi == 410} {
  270.                     set wi 10
  271.                     incr ht 20
  272.                 }
  273.             }
  274.         }
  275.         if {$wi == 210} {incr ht 20}
  276.         if {$ht < 130} {set ht 130}
  277.         set values [eval [concat dialog -w 490 -h $ht \
  278.         -b OK 340 10 405 30 -b Cancel 340 40 405 60 $box]]
  279.         if {[lindex $values 1]} {
  280.             error "Cancel"
  281.         } elseif {$num > 1 && [lindex $values 5]} {
  282.             error "Remove last!"
  283.         } elseif {[lindex $values 0]} {
  284.             set thisattr [string trim [lindex $values 2]]
  285.             set thistype [lindex $values 3]
  286.             if {$thistype != "Event handler"} {set thisattr [string toupper $thisattr]}
  287.             set required [lindex $values 4]
  288.             if {![regexp {^[-_a-zA-Z0-9]*$} $thisattr]} {
  289.                 alertnote "Invalid characters in attribute. For example, it may not contain spaces."
  290.             } elseif {[string length $thisattr]} {
  291.                 if {$required && $thistype == "Event handler"} {
  292.                     alertnote "Event handlers cannot be required attributes. It will be optional."
  293.                     set required 0
  294.                 }
  295.                 set invalidInput 0
  296.             }
  297.         } else {
  298.             return
  299.         }
  300.     }
  301.  
  302.     return [list $thisattr $thistype $required]
  303. }
  304.  
  305. # Dialogs to give more info about new attributes.
  306. proc htmlCustomAttrFix {element attr type allHTMLattrs {allchoices ""}} {
  307.     global htmlURLAttr htmlColorAttr htmlWindowAttr
  308.     global specURL specColor specWindow
  309.  
  310.     # Check for special case with URL etc. if not called from htmlCustomNewChoice 
  311.     # (then allchoices has length >0)
  312.     foreach ucw [list URL Color Window] {
  313.         if {[lsearch -exact [set html${ucw}Attr] "$attr="] >= 0 && $type != $ucw && ![llength $allchoices]} {
  314.             lappend spec$ucw "$element!=$attr"
  315.         }
  316.     }
  317.     
  318.     switch $type {
  319.         Other {return [list "$attr=" $type]}
  320.         Number {
  321.             set values {0 0 0 {} 0}
  322.             while {1} {
  323.                 set box "-t {Range for $attr} 60 10 290 25 -t {Minvalue:} 10 40 100 55 \
  324.                 -e [list [lindex $values 2]] 110 40 130 55 -t {Maxvalue:} 150 40 240 55 \
  325.                 -e [list [lindex $values 3]] 250 40 270 55 -c {Value may be given in percent} \
  326.                 [lindex $values 4] 10 65 250 80"
  327.                 set values [eval [concat dialog -w 300 -h 120 \
  328.                 -b OK 20 90 85 110 -b Cancel 105 90 170 110 $box]]
  329.                 set min [string trim [lindex $values 2]]
  330.                 set max [string trim [lindex $values 3]]
  331.                 set percent [lindex $values 4]
  332.                 if {[lindex $values 1]} {
  333.                     error "Cancel"
  334.                 } elseif {[lindex $values 0]} {
  335.                     if {![htmlIsInteger $min]} {
  336.                         alertnote "A minimum value must be specified."
  337.                     } elseif {[string length $max] && ![htmlIsInteger $max]} {
  338.                         alertnote "Not a valid number for maximum value."
  339.                     } elseif {[string length $max] && $max < $min} {
  340.                         alertnote "Maxvalue is smaller than minvalue."
  341.                     } else {
  342.                         break
  343.                     }
  344.                 }
  345.             }
  346.             set number "$min:"
  347.             if {[string length $max]} {
  348.                 append number "$max:"
  349.             } else {
  350.                 append number "i:"
  351.             }
  352.             if {$percent} {
  353.                 append number "%"
  354.             } else {
  355.                 append number "n"
  356.             }
  357.             return [list "$attr=" $type $number]
  358.         }
  359.         Choices {
  360.             set i 0
  361.             set choices {}
  362.             while {1} {
  363.                 incr i
  364.                 set values {0 0 {}}
  365.                 set invalidInput 1
  366.                 while {$invalidInput} {
  367.                     set box "-t {Choice $i for $attr} 10 10 210 25 \
  368.                     -e [list [lindex $values 2]] 10 40 200 55"
  369.                     if {$i > 1} {append box " -b {No more choices} 220 70 340 90 -b {Remove last} 220 100 340 120"}
  370.                     set wi 10
  371.                     set ht 90
  372.                     if {[llength $allchoices]} {
  373.                         append box " -t {All choices} 10 70 200 85"
  374.                         foreach ch $allchoices {
  375.                             append box " -t $ch $wi $ht [expr $wi + 95] [expr $ht + 15]"
  376.                             incr wi 100
  377.                             if {$wi == 210} {
  378.                                 set wi 10
  379.                                 incr ht 20
  380.                             }
  381.                         }
  382.                     }
  383.                     if {$wi == 110} {incr ht 20}
  384.                     if {$ht < 130} {set ht 130}
  385.                     set values [eval [concat dialog -w 350 -h $ht \
  386.                     -b OK 220 10 285 30 -b Cancel 220 40 285 60 \
  387.                     $box]]
  388.                     if {[lindex $values 1]} {
  389.                         error "Cancel"
  390.                     } elseif {$i > 1 && [lindex $values 3] } {
  391.                         return [list "$attr=" $type $choices]
  392.                     } elseif {$i > 1 && [lindex $values 4]} {
  393.                         incr i -1
  394.                         set choices [lreplace $choices [expr [llength $choices] - 1] [expr [llength $choices] - 1]]
  395.                         set allchoices [lreplace $allchoices [expr [llength $allchoices] - 1] [expr [llength $allchoices] - 1]]
  396.                     } elseif {[lindex $values 0]} {
  397.                         set thischoice [string toupper [string trim [lindex $values 2]]]
  398.                         if {![regexp {^[-_a-zA-Z0-9\.]*$} $thischoice]} {
  399.                             alertnote "Invalid characters in choice.  For example, it may not contain spaces."
  400.                         } elseif {[string length $thischoice]} {
  401.                             if {[lsearch -exact $allchoices $thischoice] >=0 } {
  402.                                 alertnote "$attr already has a choice '$thischoice'."
  403.                             } else {
  404.                                 set invalidInput 0
  405.                             }
  406.                         }
  407.                     }
  408.                 }
  409.                 lappend choices $thischoice
  410.                 lappend allchoices $thischoice
  411.             }
  412.         }
  413.         Flag {return [list $attr $type]}
  414.         URL {
  415.             if {[lsearch -exact $htmlURLAttr "$attr="] < 0 && ([lsearch -exact $allHTMLattrs "$attr="] >= 0
  416.             || [lsearch -exact $allHTMLattrs $attr] >= 0)} {
  417.                 lappend specURL "${element}=$attr"
  418.             }
  419.             return [list "$attr=" $type]
  420.         }
  421.         Color {
  422.             if {[lsearch -exact $htmlColorAttr "$attr="] < 0 && ([lsearch -exact $allHTMLattrs "$attr="] >= 0
  423.             || [lsearch -exact $allHTMLattrs $attr] >= 0)} {
  424.                 lappend specColor "${element}=$attr"
  425.             }
  426.             return [list "$attr=" $type]
  427.         }
  428.         Window {
  429.             if {[lsearch -exact $htmlWindowAttr "$attr="] < 0 && ([lsearch -exact $allHTMLattrs "$attr="] >= 0
  430.             || [lsearch -exact $allHTMLattrs $attr] >= 0)} {
  431.                 lappend specWindow "${element}=$attr"
  432.             }
  433.             return [list "$attr=" $type]
  434.         }
  435.         "Event handler" {
  436.             return [list "$attr=" $type]
  437.         }
  438.     }
  439.     
  440. }
  441.  
  442. proc htmlSetCustProc1 {values elemType element} {
  443.     set box "-t {Layout} 80 10 180 25 \
  444.     -c {Always a new line before tag.} [lindex $values 0] 10 40 225 55 \
  445.     -c {Always a new line after tag.} [lindex $values 1] 10 60 225 75 \
  446.     -b OK 20 90 85 110 -b Cancel 105 90 170 110"
  447.     set values [eval [concat dialog -w 230 -h 120 $box]]
  448.     if {[lindex $values 3]} {return}
  449.     switch $elemType {
  450.         normal {set  customproc "htmlBuildOpening $element"}
  451.         input {set customproc "htmlBuildInputElem $element"}
  452.         plugin {set customproc "htmlBuildOpening EMBED"}
  453.     }
  454.     lappend customproc [lindex $values 0] [lindex $values 1]
  455.     if {$elemType == "plugin"} {lappend customproc $element}
  456.     return $customproc
  457. }
  458.  
  459. proc htmlSetCustProc2 {values element} {
  460.     set box "-t {Layout} 80 10 180 25 \
  461.     -r {text<TAG>text</TAG>text} [lindex $values 0] 10 40 200 60 \
  462.     -r {text\r<TAG>text</TAG>\rtext} [lindex $values 1] 10 70 150 130 \
  463.     -r {blank line\r<TAG>text</TAG>\rblank line} [lindex $values 2] 10 140 150 200 \
  464.     -r {blank line\r<TAG>\rtext\r</TAG>\rblank line} [lindex $values 3] 10 210 150 310"
  465.     set values [eval [concat dialog -w 200 -h 350 \
  466.     -b OK 20 320 85 340 -b Cancel 105 320 170 340 $box]]
  467.     if {[lindex $values 1]} {return}
  468.     if {[lindex $values 2]} {set customproc "htmlBuildElem $element"}
  469.     if {[lindex $values 3]} {set customproc "htmlBuildCRElem $element"}
  470.     if {[lindex $values 4]} {set customproc "htmlBuildCRElem $element 1"}
  471.     if {[lindex $values 5]} {set customproc "htmlBuildCR2Elem $element"}
  472.     return $customproc
  473. }
  474.  
  475. # Add new attributes to an element.
  476. proc htmlNewAttributes {} {
  477.     global htmlElemAttrOptional1 htmlURLAttr htmlColorAttr htmlWindowAttr htmlElemKeyBinding
  478.     global PREFS htmlElemAttrRequired1 htmlElemAttrChoices1 htmlElemAttrNumber1
  479.     global htmlElemEventHandler1 HTMLmodeVars htmlSpecURL htmlSpecColor htmlSpecWindow
  480.     global specURL specColor specWindow htmlVersion htmlShownWarning htmlAdditionExist htmlPackageToUse
  481.     
  482.     if {$htmlPackageToUse != 1} {beep; return}
  483.     if {[info exists htmlShownWarning]} {htmlDisabled}
  484.     
  485.     if {[catch {listpick -p "Select element to add attributes to." \
  486.     [lsort [array names htmlElemAttrOptional1]]} element] || \
  487.     ![string length $element]} {return}
  488.     set allattrs {}
  489.     foreach e [htmlGetRequired $element] {
  490.         lappend allattrs [string trimright $e =]
  491.     }
  492.     foreach e [htmlGetOptional $element 1] {
  493.         lappend allattrs [string trimright $e =]
  494.     } 
  495.     foreach e [htmlGetEvent $element] {
  496.         lappend allattrs [string trimright $e =]
  497.     }
  498.     set attributes [htmlGetCustomAttrs $element $allattrs 0]
  499.     if {![string length [join $attributes ""]]} {return}
  500.     set AttrOptional [lindex $attributes 0]
  501.     set AttrRequired [lindex $attributes 1]
  502.     set AttrNumber [lindex $attributes 2]
  503.     set AttrChoices [lindex $attributes 3]
  504.     set EventHandler [lindex $attributes 4]
  505.     set URL [lindex $attributes 5]
  506.     set Color [lindex $attributes 6]
  507.     set Window [lindex $attributes 7]
  508.     
  509.     if {[regexp { } $element]} {
  510.         set arg "\[list $element\]"
  511.     } else {
  512.         set arg $element
  513.     }
  514.     
  515.     # Save the element
  516.     message "Saving new attributes…"
  517.     set isfile [file exists $PREFS:HTMLadditions.tcl]
  518.     if {![file exists $PREFS]} {mkdir $PREFS}
  519.     set fid [open $PREFS:HTMLadditions.tcl a+]
  520.     if {!$isfile} {puts $fid $htmlVersion}
  521.     foreach rcne [list AttrRequired AttrChoices AttrNumber EventHandler AttrOptional] {
  522.         if {[string length [set $rcne]]} {
  523.             puts $fid "[list $element] \{lappend htmlElem${rcne}1($arg) [set $rcne]\}"
  524.             append htmlElem${rcne}1($element) " " [set $rcne]
  525.         }
  526.     }
  527.     foreach ucw [list URL Color Window] {
  528.         if {[string length [set $ucw]]} {
  529.             foreach a [set $ucw] {
  530.                 puts $fid "[list $element] \{lappend html${ucw}Attr $a\}"
  531.                 lappend html${ucw}Attr $a
  532.             }
  533.         }
  534.     }
  535.     foreach ucw [list URL Color Window] {
  536.         if {[llength [set spec$ucw]]} {
  537.             puts $fid "[list $element] \{lappend htmlSpec$ucw [set spec$ucw]\}"
  538.             append htmlSpec$ucw " " [set spec$ucw]
  539.         }
  540.     }
  541.     close $fid
  542.     set htmlAdditionExist 1
  543.     htmlEnableExtend [info exists htmlElemKeyBinding] $htmlAdditionExist    
  544.     if {!$HTMLmodeVars(simpleColoring)} {
  545.         regModeKeywords -a -k $HTMLmodeVars(attributeColor) \
  546.         HTML [concat $AttrRequired $AttrOptional]    
  547.     }
  548.     unset specURL
  549.     unset specColor
  550.     unset specWindow
  551.     message "Done."
  552.     if {[htmlUseAttrsIsEnabled] && [llength [htmlGetOptional $element 1]]} {htmlUseAttributes $element}
  553. }
  554.  
  555. # Add new choices to an attribute with predefined choices.
  556. proc htmlNewChoices {} {
  557.     global htmlElemAttrChoices1 PREFS htmlVersion htmlShownWarning htmlAdditionExist htmlPackageToUse
  558.     global htmlElemKeyBinding
  559.     
  560.     if {$htmlPackageToUse != 1} {beep; return}
  561.     if {[info exists htmlShownWarning]} {htmlDisabled}
  562.  
  563.     if {[catch {listpick -p "Select element to add choices to." \
  564.     [lsort [array names htmlElemAttrChoices1]]} element] || \
  565.     ![string length $element]} {return}
  566.     set choiceatts ""
  567.     foreach e $htmlElemAttrChoices1($element) {
  568.         regexp {[^=]*} $e attr
  569.         if {[lsearch $choiceatts $attr] < 0} {lappend choiceatts $attr}
  570.     }
  571.     if {[catch {listpick -p "Select attribute to add choices to." [lsort $choiceatts]} attr] || \
  572.     ![string length $attr]} {return}
  573.     foreach c $htmlElemAttrChoices1($element) {
  574.         if {[string match "${attr}=*" $c]} {
  575.             lappend allchoices [string range $c [expr [string length $attr] + 1] end]
  576.         }    
  577.     }
  578.     
  579.     set newchoices [htmlCustomAttrFix $element $attr Choices [htmlGetAllAttrs] $allchoices]
  580.     foreach c [lindex $newchoices 2] {
  581.         lappend choices "${attr}=$c"
  582.     }
  583.     
  584.     if {[regexp { } $element]} {
  585.         set arg "\[list $element\]"
  586.     } else {
  587.         set arg $element
  588.     }
  589.     # Save the choices
  590.     set isfile [file exists $PREFS:HTMLadditions.tcl]
  591.     if {![file exists $PREFS]} {mkdir $PREFS}
  592.     set fid [open $PREFS:HTMLadditions.tcl a+]
  593.     if {!$isfile} {puts $fid $htmlVersion}
  594.     puts $fid "[list $element] \{lappend htmlElemAttrChoices1($arg) $choices\}"
  595.     append htmlElemAttrChoices1($element) " " $choices
  596.     close $fid
  597.     set htmlAdditionExist 1
  598.     htmlEnableExtend [info exists htmlElemKeyBinding] $htmlAdditionExist    
  599.     message "New choices saved."
  600. }
  601.  
  602. #
  603. # Change key binding for a custom element.
  604. #
  605. proc htmlChangeKeyBinding {} {
  606.     global htmlElemKeyBinding PREFS htmlShownWarning htmlPackageToUse cssModeIsLoaded
  607.     
  608.     if {$htmlPackageToUse != 1} {beep; return}
  609.     if {[info exists htmlShownWarning]} {htmlDisabled}
  610.  
  611.     if {![info exists htmlElemKeyBinding]} {
  612.         alertnote "No custom elements are defined."
  613.         return
  614.     }
  615.     if {[catch {listpick -p "Select element to change key binding for." \
  616.     [lsort [array names htmlElemKeyBinding]]} elem] || ![string length $elem]} {return}
  617.     if {[catch {htmlGetAKey $elem $htmlElemKeyBinding($elem)} keyStr]} {return}
  618.     if {![file exists $PREFS:HTMLadditions.tcl]} {
  619.         alertnote "Cannot find 'HTMLadditions.tcl'. Key binding cannot be changed."
  620.         return
  621.     }
  622.     set fid [open $PREFS:HTMLadditions.tcl r]
  623.     set filecont [string trimright [read $fid] "\n"]
  624.     close $fid
  625.     foreach line [split $filecont "\n"] {
  626.         if {[lindex $line 0] == $elem && [regexp {htmlElemKeyBinding} $line]} {
  627.             append newlines "$elem \{set htmlElemKeyBinding($elem) [list $keyStr]\}\n"
  628.         } else {
  629.             append newlines "$line\n"
  630.         }
  631.     }
  632.     set fid [open $PREFS:HTMLadditions.tcl w]
  633.     puts -nonewline $fid $newlines
  634.     close $fid
  635.     htmlDeleteCache "CSS keybindings cache"
  636.     if {[info exists cssModeIsLoaded]} {
  637.         cssBindOneKey $htmlElemKeyBinding($elem) $elem un
  638.         cssBindOneKey $keyStr $elem
  639.     }
  640.     set htmlElemKeyBinding($elem) $keyStr
  641.     htmlRebuildMenu "Redefining key binding…"
  642.     message "Done."
  643. }
  644.  
  645. #
  646. # Change type and layout for a custom element.
  647. #
  648. proc htmlChangeTypeandLayout {} {
  649.     global htmlElemKeyBinding htmlElemProc PREFS htmlPlugins htmlShownWarning htmlPackageToUse
  650.     
  651.     if {$htmlPackageToUse != 1} {beep; return}
  652.     if {[info exists htmlShownWarning]} {htmlDisabled}
  653.  
  654.     if {![info exists htmlElemKeyBinding]} {
  655.         alertnote "No custom elements are defined."
  656.         return
  657.     }
  658.     if {[catch {listpick -p "Select element to change type and layout for." \
  659.     [lsort [array names htmlElemKeyBinding]]} elem] || ![string length $elem]} {return}
  660.     set eproc $htmlElemProc($elem)
  661.     set proctype [lindex $eproc 0]
  662.     if {$proctype == "htmlBuildOpening" || $proctype == "htmlBuildInputElem"} {
  663.         if {[lindex $eproc 1] == "EMBED"} {
  664.             set type plugin
  665.         } else {
  666.             set type normal
  667.         }
  668.         if {$proctype == "htmlBuildInputElem"} {set type input}
  669.         set closing 0
  670.         set values "[lindex $eproc 2] [lindex $eproc 3]"
  671.     } else {
  672.         set type normal
  673.         set closing 1
  674.         if {$proctype == "htmlBuildElem"} {set values {1 0 0 0}}
  675.         if {$proctype == "htmlBuildCRElem" && [llength $eproc] == 2} {set values {0 1 0 0}}
  676.         if {$proctype == "htmlBuildCRElem" && [llength $eproc] == 3} {set values {0 0 1 0}}
  677.         if {$proctype == "htmlBuildCR2Elem"} {set values {0 0 0 1}}
  678.     }
  679.     set box "-t $elem 100 10 300 25 \
  680.     -c {Has closing tag} $closing 10 40 150 55 \
  681.     -t {Element type} 10 80 100 95 -r Normal [regexp {normal} $type] 10 100 100 115 \
  682.     -r {INPUT element with TYPE given above} [regexp {input} $type] 10 120 300 135 \
  683.     -r {Plug-in} [regexp {plugin} $type] 10 140 100 155 \
  684.     -b OK 20 170 85 190 -b Cancel 105 170 170 190"
  685.     set typeval [eval [concat dialog -w 310 -h 200 $box]]
  686.     if {[lindex $typeval 5]} {return}
  687.     set newclosing [lindex $typeval 0]
  688.     if {[lindex $typeval 1]} {set newtype normal}
  689.     if {[lindex $typeval 2]} {set newtype input; set newclosing 0}
  690.     if {[lindex $typeval 3]} {set newtype plugin; set newclosing 0}
  691.  
  692.     if {$newclosing} {
  693.         if {$newclosing != $closing} {set values {1 0 0 0}}
  694.         set customproc [htmlSetCustProc2 $values $elem]
  695.     } else {
  696.         if {$newclosing != $closing} {set values {0 0}}
  697.         set customproc [htmlSetCustProc1 $values $newtype $elem]
  698.     }
  699.     if {![string length $customproc]} {return}
  700.     
  701.     if {![file exists $PREFS:HTMLadditions.tcl]} {
  702.         alertnote "Cannot find 'HTMLadditions.tcl'. Type and layout cannot be changed."
  703.         return
  704.     }
  705.     set fid [open $PREFS:HTMLadditions.tcl r]
  706.     set filecont [string trimright [read $fid] "\n"]
  707.     close $fid
  708.     foreach line [split $filecont "\n"] {
  709.         if {[lindex $line 0] == $elem && [regexp {htmlElemProc} $line]} {
  710.             append newlines "$elem \{set htmlElemProc($elem) [list $customproc]\}\n"
  711.         } elseif {$type == "plugin" && $newtype != "plugin" && [lindex $line 0] == $elem && \
  712.         [regexp {htmlPlugins} $line]} {
  713.             set where [lsearch -exact $htmlPlugins $elem]
  714.             set htmlPlugins [lreplace $htmlPlugins $where $where]
  715.         } else {
  716.             append newlines "$line\n"
  717.         }
  718.     }
  719.     if {$newtype == "plugin" && $type != "plugin"} {
  720.         lappend htmlPlugins $elem
  721.         append newlines "$elem \{lappend htmlPlugins $elem\}\n"
  722.     }
  723.     set fid [open $PREFS:HTMLadditions.tcl w]
  724.     puts -nonewline $fid $newlines
  725.     close $fid
  726.     set htmlElemProc($elem) $customproc
  727.     message "Type and layout redefined."
  728. }
  729.  
  730. # Remove custom element ot additions to an element.
  731. proc htmlRemoveAdditions {} {
  732.     global htmlElemAttrOptional1 htmlURLAttr htmlColorAttr htmlWindowAttr cssModeIsLoaded
  733.     global PREFS htmlElemAttrRequired1 htmlElemAttrChoices1 htmlElemAttrNumber1
  734.     global htmlElemEventHandler1 htmlElemProc htmlElemKeyBinding htmlPlugins
  735.     global htmlSpecURL htmlSpecColor htmlSpecWindow htmlVersion htmlShownWarning htmlAdditionExist htmlPackageToUse
  736.     
  737.     if {$htmlPackageToUse != 1} {beep; return}
  738.     
  739.     if {[info exists htmlShownWarning]} {htmlDisabled}
  740.     
  741.     if {![file exists $PREFS:HTMLadditions.tcl]} {
  742.         if {[info exists htmlElemKeyBinding]} {
  743.             alertnote "Cannot find 'HTMLadditions.tcl'. Custom additions cannot be removed."
  744.         } else {
  745.             alertnote "No custom additions has been made."
  746.         }
  747.         return
  748.     }
  749.     set fid [open $PREFS:HTMLadditions.tcl r]
  750.     set additions [string trimright [read $fid] "\n"]
  751.     close $fid
  752.     set elems ""
  753.     foreach line [lrange [split $additions "\n"] 1 end] {
  754.         set element [lindex $line 0]
  755.         if {[lsearch -exact $elems $element] < 0} {lappend elems $element}
  756.     }
  757.     if {[catch {listpick -p "Select element to remove additions from." [lsort $elems]} element] || \
  758.     ![string length $element] || [askyesno "Remove additions from $element?"] == "no"} {return}
  759.     
  760.  
  761.     message "Removing additions to $element…"
  762.     set isNewElem [info exists htmlElemKeyBinding($element)]
  763.     # If new element, unset all its variables.
  764.     if {$isNewElem} {
  765.         catch {unset htmlElemAttrRequired1($element)}
  766.         catch {unset htmlElemAttrChoices1($element)}
  767.         catch {unset htmlElemAttrNumber1($element)}
  768.         catch {unset htmlElemAttrOptional1($element)}
  769.         catch {unset htmlElemEventHandler1($element)}
  770.         if {[info exists cssModeIsLoaded]} {
  771.             cssBindOneKey $htmlElemKeyBinding($element) $element un
  772.         }
  773.         set tmpkey $htmlElemKeyBinding($element)
  774.         catch {unset htmlElemKeyBinding($element)}
  775.         catch {unset htmlElemProc($element)}
  776.         set isPlugin [lsearch -exact $htmlPlugins $element]
  777.         if {$isPlugin >=0 } {set htmlPlugins [lreplace $htmlPlugins $isPlugin $isPlugin]}
  778.         if {![llength [array names htmlElemKeyBinding]]} {
  779.             catch {unset htmlElemKeyBinding}
  780.             if {[string length $tmpkey]} {
  781.                 set key [string tolower [string range $tmpkey [expr [string length $tmpkey] - 1] end]]
  782.                 set mods ""
  783.                 foreach m [split [string range $tmpkey 1 [expr [string length $tmpkey] - 3]] < ] {
  784.                     if {$m == "B"} {append mods z}
  785.                     if {$m == "I"} {append mods o}
  786.                     if {$m == "U"} {append mods s}
  787.                     if {$m == "O"} {append mods c}
  788.                 }
  789.                 catch {unbind '$key' <$mods> {} HTML}
  790.             }
  791.         }
  792.         if {![llength [array names htmlElemProc]]} {catch {unset htmlElemProc}}
  793.     }
  794.     set newlines ""
  795.     foreach line [lrange [split $additions "\n"] 1 end] {
  796.         set command [lindex $line 1]
  797.         if {[lindex $line 0] != $element} {
  798.             append newlines "$line\n"
  799.         } elseif {[lindex $command 0] == "lappend"} {
  800.             set var [lindex $command 1]
  801.             # Remove from URL, Color and Window lists.
  802.             foreach ucw [list URL Color Window] {
  803.                 if {$var == "html${ucw}Attr"} {
  804.                     lappend ${ucw}maybe [lindex $command 2]
  805.                     set where [lsearch -exact [set html${ucw}Attr] [lindex $command 2]]
  806.                     set html${ucw}Attr [lreplace [set html${ucw}Attr] $where $where]
  807.                 }
  808.                 if {$var == "htmlSpec${ucw}"} {
  809.                     foreach c [lrange $command 2 end] {
  810.                         set where [lsearch -exact [set htmlSpec${ucw}] $c]
  811.                         set htmlSpec${ucw} [lreplace [set htmlSpec${ucw}] $where $where]
  812.                     }
  813.                 }
  814.             } 
  815.             # If added attribute to old element, remove attribute
  816.             if {!$isNewElem && $var != "htmlURLAttr" && $var != "htmlColorAttr" && \
  817.             $var != "htmlWindowAttr" && $var != "htmlSpecURL" && $var != "htmlSpecColor" && \
  818.             $var != "htmlSpecWindow"} {
  819.                 regexp {([^\(]+)\(([^\)]+)\)[ ]+(.+)} [lrange $command 1 end] dummy var arg added
  820.                 foreach c $added {
  821.                     set where [lsearch -exact [set ${var}($element)] $c]
  822.                     set ${var}($element) [lreplace [set ${var}($element)] $where $where]
  823.                 }
  824.             }
  825.         }
  826.     }
  827.     # Unset empty lists for old variables.
  828.     if {!$isNewElem} {
  829.         foreach c [list AttrRequired AttrChoices AttrNumber EventHandler] {
  830.             if {[info exists html${c}1($element)] && ![llength html${c}1($element)]} {
  831.                 unset html${c}1($element)
  832.             }
  833.         }
  834.     }
  835.     # URL, Color or Window attributes just removed
  836.     # should be replaced if they are used by some other element.
  837.     foreach ucw [list URL Color Window] {
  838.         if {[info exists ${ucw}maybe]} {
  839.             append newlines [htmlUCWmaybe $ucw [set ${ucw}maybe]]
  840.         }
  841.     }
  842.     if {[string length $newlines]} {
  843.         set fid [open $PREFS:HTMLadditions.tcl w]
  844.         puts -nonewline $fid "$htmlVersion\n$newlines"
  845.         close $fid
  846.     } else {
  847.         removeFile $PREFS:HTMLadditions.tcl
  848.         set htmlAdditionExist 0
  849.     }
  850.     htmlDeleteCache "CSS keybindings cache"
  851.     htmlEnableExtend [info exists htmlElemKeyBinding] $htmlAdditionExist
  852.     if {$isNewElem} {htmlRebuildMenu "Rebuilding HTML menu…"}
  853.     message "Done."
  854. }
  855.  
  856. proc htmlUCWmaybe {ucw maybe} {
  857.     global htmlElemAttrRequired1 htmlElemAttrOptional1 htmlSpecURL htmlSpecColor htmlSpecWindow
  858.     global htmlURLAttr htmlColorAttr htmlWindowAttr
  859.     
  860.     set newlines ""
  861.     foreach m $maybe {
  862.         set foundit 0
  863.         foreach e [array names htmlElemAttrRequired1] {
  864.             if {[lsearch -exact $htmlElemAttrRequired1($e) $m] >= 0 && \
  865.             [lsearch -exact [set htmlSpec$ucw] "$e!=[string trimright $m =]"] < 0} {
  866.                 append newlines "[list $e] \{lappend html${ucw}Attr $m\}\n"
  867.                 lappend html${ucw}Attr $m
  868.                 set foundit 1
  869.                 break
  870.             } 
  871.         }
  872.         if {$foundit} {continue}
  873.         foreach e [array names htmlElemAttrOptional1] {
  874.             if {[lsearch -exact $htmlElemAttrOptional1($e) $m] >= 0 && \
  875.             [lsearch -exact [set htmlSpec$ucw] "$e!=[string trimright $m =]"] < 0} {
  876.                 append newlines "[list $e] \{lappend html${ucw}Attr $m\}\n"
  877.                 lappend html${ucw}Attr $m
  878.                 break
  879.             } 
  880.         }
  881.     }
  882.     return $newlines
  883. }
  884.  
  885. # Remove custom element ot additions to an element.
  886. proc htmlRemoveAttributes {} {
  887.     global htmlElemAttrOptional1 htmlURLAttr htmlColorAttr htmlWindowAttr
  888.     global PREFS htmlElemAttrRequired1 htmlElemAttrChoices1 htmlElemAttrNumber1
  889.     global htmlElemEventHandler1 htmlAdditionExist htmlElemKeyBinding
  890.     global htmlSpecURL htmlSpecColor htmlSpecWindow htmlVersion htmlShownWarning htmlPackageToUse
  891.     
  892.     if {$htmlPackageToUse != 1} {beep; return}
  893.     if {[info exists htmlShownWarning]} {htmlDisabled}
  894.     
  895.     if {![file exists $PREFS:HTMLadditions.tcl]} {
  896.         if {[info exists htmlElemKeyBinding]} {
  897.             alertnote "Cannot find 'HTMLadditions.tcl'. Custom additions cannot be removed."
  898.         } else {
  899.             alertnote "No custom additions has been made."
  900.         }
  901.         return
  902.     }
  903.     set fid [open $PREFS:HTMLadditions.tcl r]
  904.     set additions [string trimright [read $fid] "\n"]
  905.     close $fid
  906.     set elems ""
  907.     foreach line [lrange [split $additions "\n"] 1 end] {
  908.         set element [lindex $line 0]
  909.         if {[lsearch -exact $elems $element] < 0 && \
  910.         [llength [concat [htmlGetRequired $element] [htmlGetOptional $element 1] [htmlGetEvent $element]]]} {
  911.             lappend elems $element
  912.         }
  913.     }
  914.     if {[catch {listpick -p "Select element to remove attributes from." [lsort $elems]} element] || \
  915.     ![string length $element]} {return}
  916.     
  917.     set allatts {}
  918.     foreach line [lrange [split $additions "\n"] 1 end] {
  919.         set command [lindex $line 1]
  920.         if {[lindex $line 0] == $element} {
  921.             regexp {([^\(]+)\(([^\)]+)\)[ ]+(.+)} [lrange $command 1 end] dummy var arg added
  922.             set added [string trimleft [string trimright $added \}] \{]
  923.             if {$var == "htmlElemAttrRequired1" || $var == "htmlElemAttrOptional1" || $var == "htmlElemEventHandler1"} {
  924.                 foreach c $added {
  925.                     if {[lsearch -exact $allatts [string trimright $c =]] < 0} {
  926.                         lappend allatts [string trimright $c =]
  927.                     }
  928.                 }
  929.             } elseif {$var == "htmlElemAttrChoices1"} {
  930.                 foreach c $added {
  931.                     regexp {[^=]+} $c tmp
  932.                     if {[lsearch -exact $allatts $tmp] < 0} {
  933.                         lappend allatts $tmp
  934.                     }
  935.                 }
  936.             }
  937.         }
  938.     }
  939.     
  940.     if {[catch {listpick -p "Select attributes to remove." -l [lsort $allatts]} attrs] || \
  941.     ![string length $attrs]} {return}
  942.     
  943.     set newlines ""
  944.     foreach line [lrange [split $additions "\n"] 1 end] {
  945.         set command [lindex $line 1]
  946.         if {[lindex $line 0] != $element} {
  947.             append newlines "$line\n"
  948.         } else {
  949.             set var [lindex $command 1]
  950.             # Remove from URL, Color and Window lists.
  951.             foreach ucw [list URL Color Window] {
  952.                 if {$var == "html${ucw}Attr"} {
  953.                     if {[lsearch -exact $attrs [string trimright [lindex $command 2] =]] >= 0} {
  954.                         lappend ${ucw}maybe [lindex $command 2]
  955.                         set where [lsearch -exact [set html${ucw}Attr] [lindex $command 2]]
  956.                         set html${ucw}Attr [lreplace [set html${ucw}Attr] $where $where]
  957.                     } else {
  958.                         append newlines "$line\n"
  959.                     }
  960.                 }
  961.                 if {$var == "htmlSpec${ucw}"} {
  962.                     set tmpadd [lrange $command 2 end]
  963.                     foreach c $tmpadd {
  964.                         regexp {[^!=]+!?=(.*)} $c dum tmp
  965.                         if {[lsearch -exact $attrs $tmp] >= 0} {
  966.                             set where [lsearch -exact [set htmlSpec${ucw}] $c]
  967.                             set htmlSpec${ucw} [lreplace [set htmlSpec${ucw}] $where $where]
  968.                             set where [lsearch -exact $tmpadd $c]
  969.                             set tmpadd [lreplace $tmpadd $where $where]
  970.                         }
  971.                     }
  972.                     if {[llength $tmpadd]} {append newlines "[list $element] \{lappend htmlSpec${ucw} $tmpadd\}\n"} 
  973.                 }
  974.             } 
  975.             if {[lsearch {htmlURLAttr htmlColorAttr htmlWindowAttr htmlSpecURL htmlSpecColor htmlSpecWindow htmlPlugins} $var] < 0 && \
  976.             ![string match "htmlElemKeyBinding*" $var] && ![string match "htmlElemProc*" $var]} {
  977.                 regexp {([^\(]+)\(([^\)]+)\)[ ]+(.+)} [lrange $command 1 end] dummy var arg added
  978.                 set added [string trimleft [string trimright $added \}] \{]
  979.                 foreach c $added {
  980.                     regexp {[^=]+} $c tmp
  981.                     if {[lsearch -exact $attrs $tmp] >= 0} {
  982.                         set where [lsearch -exact [set ${var}($element)] $c]
  983.                         set ${var}($element) [lreplace [set ${var}($element)] $where $where]
  984.                         set where [lsearch -exact $added $c]
  985.                         set added [lreplace $added $where $where]
  986.                     }
  987.                 }
  988.                 if {[llength $added] || ([lindex $command 0] == "set" && $var == "htmlElemAttrOptional1")} {
  989.                     if {[lindex $command 0] == "set"} {set added [list $added]}
  990.                     append newlines "[list $element] \{[lindex $command 0] ${var}($arg) $added\}\n"
  991.                 }
  992.             }
  993.             if {[string match "htmlElemKeyBinding*" $var] || [string match "htmlElemProc*" $var]} {
  994.                 append newlines "$line\n"
  995.             }
  996.         }
  997.     }
  998.     # Unset empty lists.
  999.     foreach c [list AttrRequired AttrChoices AttrNumber EventHandler] {
  1000.         if {[info exists html${c}1($element)] && ![llength html${c}1($element)]} {
  1001.             unset html${c}1($element)
  1002.         }
  1003.     }
  1004.     # URL, Color or Window attributes just removed
  1005.     # should be replaced if they are used by some other element.
  1006.     foreach ucw [list URL Color Window] {
  1007.         if {[info exists ${ucw}maybe]} {
  1008.             append newlines [htmlUCWmaybe $ucw [set ${ucw}maybe]]
  1009.         }
  1010.     }
  1011.     if {[string length $newlines]} {
  1012.         set fid [open $PREFS:HTMLadditions.tcl w]
  1013.         puts -nonewline $fid "$htmlVersion\n$newlines"
  1014.         close $fid
  1015.     } else {
  1016.         removeFile $PREFS:HTMLadditions.tcl
  1017.         set htmlAdditionExist 0
  1018.     }
  1019.     htmlEnableExtend [info exists htmlElemKeyBinding] $htmlAdditionExist
  1020.     message "Attributes removed from $element."
  1021. }
  1022.  
  1023.  
  1024. #===============================================================================
  1025. #  Home pages
  1026. #===============================================================================
  1027.  
  1028. # Dialog to handle servers and corresponding home page folders.
  1029. proc htmlHomePages {{this ""}} {
  1030.     global modifiedModeVars HTMLmodeVars
  1031.     
  1032.     set pages $HTMLmodeVars(homePages)
  1033.     set servers $HTMLmodeVars(FTPservers)
  1034.     set touchedIt 0
  1035.     if {$this == ""} {set this ∞}
  1036.     while {1} {
  1037.         set box "-t {Home pages} 180 10 300 30 -t {Server URLs:} 10 40 100 60 \
  1038.         -t {Home Page Folder:} 10 70 110 110 \
  1039.         -t {Include Folder:} 10 120 110 140 -t {Default file:} 10 170 100 190 \
  1040.         -t {Ftp server:} 10 200 100 220 -t {User ID:} 10 225 100 245 \
  1041.         -t Password: 10 250 100 270 -t Directory: 10 275 100 295 \
  1042.         -b OK 10 305 75 325 -b Cancel 90 305 155 325 -b New… 170 305 235 325 \
  1043.         -c {Tell Big Brother} 0 320 275 440 295"
  1044.         if {[llength $pages]} {
  1045.             set pgs ""
  1046.             foreach pg $pages {
  1047.                 lappend pgs "[lindex $pg 1][lindex $pg 2]"
  1048.             }
  1049.             append box " -m [list [concat $this $pgs]] 110 40 440 60"
  1050.             append box " -b Change… 250 305 320 325 -b Remove 335 305 400 325"
  1051.             foreach pg $pages {
  1052.                 lappend box -n "[lindex $pg 1][lindex $pg 2]" -t [lindex $pg 0] 120 70 440 110 \
  1053.                 -t [lindex $pg 3] 110 170 310 190
  1054.                 if {[llength $pg] == 5} {lappend box -t [lindex $pg 4] 120 120 440 160}
  1055.                 foreach f $servers {
  1056.                     if {[lindex $f 0] == [lindex $pg 0]} {
  1057.                         lappend box -t [lindex $f 1] 120 200 440 220 \
  1058.                         -t [lindex $f 2] 120 225 440 245
  1059.                         set pwb ""
  1060.                         for {set i 0} {$i < [string length [lindex $f 3]]} {incr i} {
  1061.                             append pwb •
  1062.                         }
  1063.                         lappend box -t $pwb 120 250 440 270 \
  1064.                         -t [lindex $f 4] 120 275 310 295
  1065.                     }
  1066.                 }
  1067.             }
  1068.         } else {
  1069.             append box  " -m {{None defined} {None defined}} 110 40 440 60"
  1070.         }
  1071.         set values [eval [concat dialog -w 450 -h 335 $box]]
  1072.         set this [lindex $values 4]
  1073.         if {[lindex $values 0]} {
  1074.             set HTMLmodeVars(homePages) $pages
  1075.             set HTMLmodeVars(FTPservers) $servers
  1076.             lappend modifiedModeVars {homePages HTMLmodeVars} {FTPservers HTMLmodeVars}
  1077.             if {[lindex $values 3]} {
  1078.                 if {[htmlGetVersion Bbth] < 1.1} {
  1079.                     alertnote "Cannot change the settings in Big Brother. You need Big Brother 1.1 or later."
  1080.                 } elseif {[askyesno "Change URL mappings in Big Brother?"] == "yes"} {
  1081.                     if {![htmlCheckRunning Bbth] && [catch {launchBackAppl Bbth}]} {
  1082.                         alertnote "Could not find or launch Big Brother."
  1083.                         return
  1084.                     }
  1085.                     set urlmap [htmlURLmap]
  1086.                     AEBuild 'Bbth' core setd "----" "obj{want:type('mapG'),from:null(),form:'prop',seld:type('mapS')}" "data" "\[$urlmap\]"
  1087.                 }
  1088.             }
  1089.             return
  1090.         } elseif {[lindex $values 1]} {
  1091.             if {!$touchedIt || [askyesno "Really cancel without saving changes?"] == "yes"} {return}
  1092.         } elseif {[lindex $values 2]} {
  1093.             set newpg {{} {} {} "index.html" {}}
  1094.             set newserver {{} {} {} {}}
  1095.             while {1} {
  1096.                 if {[catch {htmlSetHomePages $pages [lindex $newpg 0] "[lindex $newpg 1][lindex $newpg 2]" [lindex $newpg 3] [lindex $newpg 4]} newpg]} {break}
  1097.                 if {[htmlTestHomePage $pages $newpg]} {
  1098.                     lappend pages $newpg
  1099.                     if {[lindex $newserver 0] != ""} {lappend servers [concat [list [lindex $newpg 0]] $newserver]}
  1100.                     set this "[lindex $newpg 1][lindex $newpg 2]"
  1101.                     set touchedIt 1
  1102.                     break
  1103.                 }
  1104.             }
  1105.         } else {
  1106.             for {set i 0} {$i < [llength $pages]} {incr i} {
  1107.                 if {"[lindex [lindex $pages $i] 1][lindex [lindex $pages $i] 2]" == $this} {
  1108.                     if {[lindex $values 5]} {
  1109.                         set newpg [lindex $pages $i]
  1110.                         set pg "[lindex $newpg 1][lindex $newpg 2]"
  1111.                         set oldpage [lindex $newpg 0]
  1112.                         set newserver {{} {} {} {}}
  1113.                         foreach f $servers {
  1114.                             if {[lindex $f 0] == $oldpage} {set newserver [lrange $f 1 end]}
  1115.                         }
  1116.                         while {1} {
  1117.                             if {[catch {htmlSetHomePages $pages [lindex $newpg 0] "[lindex $newpg 1][lindex $newpg 2]" [lindex $newpg 3] [lindex $newpg 4] $pg} newpg]} {break}
  1118.                             if {[htmlTestHomePage $pages $newpg $pg]} {
  1119.                                 set pages [lreplace $pages $i $i $newpg]
  1120.                                 set ns ""
  1121.                                 foreach f $servers {
  1122.                                     if {[lindex $f 0] != $oldpage} {lappend ns $f}
  1123.                                 }
  1124.                                 set servers $ns
  1125.                                 if {[lindex $newserver 0] != ""} {lappend servers [concat [list [lindex $newpg 0]] $newserver]}
  1126.                                 set this "[lindex $newpg 1][lindex $newpg 2]"
  1127.                                 set touchedIt 1
  1128.                                 break
  1129.                             }
  1130.                         }
  1131.                     } else {
  1132.                         set tpg [lindex [lindex $pages $i] 0]
  1133.                         set ns ""
  1134.                         foreach f $servers {
  1135.                             if {[lindex $f 0] != $tpg} {lappend ns $f}
  1136.                         }
  1137.                         set servers $ns
  1138.                         set pages [lreplace $pages $i $i]
  1139.                         set touchedIt 1
  1140.                     }
  1141.                 }
  1142.             }
  1143.         }
  1144.     }
  1145. }
  1146.  
  1147. # Dialog to define or change a home page.
  1148. proc htmlSetHomePages {pages folder url defFile inclFld {pg ""}} {
  1149.     upvar newserver server
  1150.     while {1} {
  1151.         set pwb ""
  1152.         for {set i 0} {$i < [string length [lindex $server 2]]} {incr i} {
  1153.             append pwb •
  1154.         }
  1155.         set val [dialog -w 450 -h 320 -t "Home Page Folder:" 10 10 135 30 -t $folder 140 10 440 50 \
  1156.         -t "Include Folder:" 10 60 110 80 -t $inclFld 130 60 440 100 \
  1157.         -t "Server URL:" 10 110 90 130 \
  1158.         -e $url 100 110 440 125 -t "Default file:" 10 145 90 160 \
  1159.         -e $defFile 100 145 440 160 \
  1160.         -t "Ftp Server:" 10 180 90 200 -e [lindex $server 0] 100 180 440 195 \
  1161.         -t "User ID:" 10 205 90 225 -e [lindex $server 1] 100 205 440 220 \
  1162.         -t "Password:" 10 230 85 250 -t $pwb 160 230 440 245 \
  1163.         -t "Directory:" 10 260 90 280 -e [lindex $server 3] 100 260 440 275 \
  1164.         -b OK 20 290 85 310 -b Cancel 110 290 175 310  -b Set… 90 230 150 250 \
  1165.         -b "Set…" 20 30 80 50 -b "Set…" 10 80 60 100 -b "Unset" 70 80 120 100]
  1166.         set url [string trim [lindex $val 0]]
  1167.         set defFile [string trim [lindex $val 1]]
  1168.         set ftp [string trim [lindex $val 2]]
  1169.         regexp {^(ftp://)?(.*)$} $ftp dum1 dum2 ftp
  1170.         set dir [string trimright [string trim [lindex $val 4]] /]
  1171.         if {[lindex $val 7] && ![catch {htmlGetPassword $ftp} newpw]} {
  1172.             set pw $newpw
  1173.         } else {
  1174.             set pw [lindex $server 2]
  1175.         }
  1176.         set server [list $ftp [string trim [lindex $val 3]] \
  1177.         $pw $dir]
  1178.         if {[lindex $val 8] && ![catch {htmlGetAhpFolder "Home Page Folder:" $pages $pg} fld]} {
  1179.             set folder $fld
  1180.         } elseif {[lindex $val 9] && ![catch {htmlGetAhpFolder "Include Folder:" $pages $pg} fld]} {
  1181.             set inclFld $fld
  1182.         } elseif {[lindex $val 10]} {
  1183.             set inclFld ""
  1184.         } elseif {[lindex $val 5]} {
  1185.             if {![regexp {://} $url] && $url != ""} {
  1186.                 alertnote "The server URL can't be a relative URL."
  1187.             } elseif {[lindex $server 0] != "" && [lindex $server 1] == ""} {
  1188.                 alertnote "When you specify an ftp server you must give the user ID."
  1189.             } elseif {$folder == $inclFld} {
  1190.                 alertnote "The home page folder and include folder can't be the same folder."
  1191.             } elseif {[string length $folder] && [string length $url] && [string length $defFile]} {
  1192.                 regexp -indices {://} $url css
  1193.                 set sl [string first / [string range $url [expr [lindex $css 1] + 1] end]]
  1194.                 if {$sl < 0} {
  1195.                     set base "$url/"
  1196.                     set path ""
  1197.                 } elseif {[string index $url [expr [string length $url] -1]] != "/"} {
  1198.                     alertnote "A directory URL ending with a slash expected."
  1199.                     continue
  1200.                 } else {
  1201.                     set base [string range $url 0 [expr [lindex $css 1] + $sl + 1]]
  1202.                     set path [string range $url [expr [lindex $css 1] + $sl + 2] end]
  1203.                 }
  1204.                 set ret [list $folder $base $path $defFile]
  1205.                 if {$inclFld != ""} {lappend ret $inclFld}
  1206.                 return  $ret
  1207.             } else {
  1208.                 alertnote "Home page folder, server URL, and default file must be specified."
  1209.             }
  1210.         } elseif {[lindex $val 6]} {
  1211.             error ""
  1212.         }
  1213.     }
  1214. }
  1215.  
  1216. proc htmlTestHomePage {pages newpg {pg ""}} {
  1217.     foreach p $pages {
  1218.         if {"[lindex $p 1][lindex $p 2]" == $pg} {continue}
  1219.         if {[string match "[lindex $p 1][lindex $p 2]*" "[lindex $newpg 1][lindex $newpg 2]"] ||
  1220.         [string match "[lindex $newpg 1][lindex $newpg 2]*" "[lindex $p 1][lindex $p 2]"]} {
  1221.             alertnote "There is already a home page folder for [lindex $p 1][lindex $p 2].\
  1222.             It overlaps with this one."
  1223.             return 0
  1224.         }
  1225.     }
  1226.     return 1
  1227. }    
  1228.  
  1229. proc htmlGetAhpFolder {txt pages pg} {
  1230.     set fld [htmlGetDir $txt]
  1231.     set msg {"home page" "" "" "" include}
  1232.     foreach p $pages {
  1233.         foreach i {0 4} {
  1234.             if {"[lindex $p 1][lindex $p 2]" == $pg && [regexp -nocase [lindex $msg $i] $txt]
  1235.             || [llength $p] == $i} {continue}
  1236.             if {[string match "[lindex $p $i]:*" "$fld:"] || [string match "$fld:*" "[lindex $p $i]:"]} {
  1237.                 alertnote "This folder overlaps with the [lindex $msg $i] folder for [lindex $p 1][lindex $p 2]."
  1238.                 error ""
  1239.             }
  1240.         }
  1241.     }
  1242.     return $fld
  1243. }
  1244.  
  1245.